﻿'-------------------------------------------------------------------------------
'Developer: Ivan Tamurejo
'-------------------------------------------------------------------------------
'This class defines a 'VBP' project for Microsoft Visual Basic 6. Allows you to 
'perform operations on the project as retrieve and set properties or compile the 
'project using the VB6 compiler file.
'
'Required classes 'Component'. 
'-------------------------------------------------------------------------------
Imports System.IO
Imports System.Text

Public Class VB6Project

#Region "Private variables"

    Private Lines As New List(Of String)
    Private LinesOriginal As New List(Of String)
    Private IsValid As Boolean
    Private IsDisposed As Boolean
    Private oComponent As Component

    Private _ProjectFilePath As String
    Private _CompilerFilePath As String
    Private _BuildsDirectory As String
    Private _NameFileBuild As String

#End Region

#Region "Procedures -New- and -Finalize-"

    Sub New(ByVal ProjectFilePath As String)

        If Not File.Exists(ProjectFilePath) Then

            Throw New Exception("> Project file does not valid or not exist.")
            IsValid = False

        Else

            IsValid = True

        End If

        _ProjectFilePath = ProjectFilePath

    End Sub

    Public Sub Dispose()

        Finalize()

    End Sub

    Protected Overrides Sub Finalize()
        MyBase.Finalize()

        If Not IsDisposed Then

            Lines = Nothing
            If Not oComponent Is Nothing Then
                oComponent.Dispose()
            End If

            IsDisposed = True

        End If

    End Sub

#End Region

#Region "Properties to indicate the builds directory and the path file to the compiler"

    Public Property CompilerFilePath() As String
        Get
            If _CompilerFilePath = "" Then
                _CompilerFilePath = "C:\Archivos de programa\Microsoft Visual Studio\VB98\VB6.EXE"
            End If

            If Not File.Exists(_CompilerFilePath) Then

                Throw New Exception("> Compiler file does not valid or not exist.")

            End If

            Return _CompilerFilePath
        End Get
        Set(ByVal value As String)
            _CompilerFilePath = value

            If Not File.Exists(_CompilerFilePath) Then

                Throw New Exception("> Compiler file does not valid or not exist.")

            End If

        End Set
    End Property

    Public Property BuildsDirectory() As String
        Get
            If Not Directory.Exists(_BuildsDirectory) Then

                Throw New Exception("> Builds directory does not valid or not exist.")

            End If

            Return _BuildsDirectory
        End Get
        Set(ByVal value As String)
            _BuildsDirectory = value

            If Not Directory.Exists(_BuildsDirectory) Then

                Throw New Exception("> Builds directory does not valid or not exist.")

            End If

        End Set
    End Property

    ReadOnly Property NameFileBuild() As String
        Get
            GetProjectProperty("ExeName32", _NameFileBuild)
            Return Replace(_NameFileBuild, Chr(34), "")
        End Get
    End Property

    ReadOnly Property CLSID() As String
        Get
            If Not oComponent Is Nothing Then
                Return oComponent.GetCLSID
            Else
                Return ""
            End If
        End Get
    End Property

    ReadOnly Property MajorVersion() As String
        Get
            If Not oComponent Is Nothing Then
                Return oComponent.GetMajorVersion
            Else
                Return ""
            End If
        End Get
    End Property

    ReadOnly Property MinorVersion() As String
        Get
            If Not oComponent Is Nothing Then
                Return oComponent.GetMinorVersion
            Else
                Return ""
            End If
        End Get
    End Property

#End Region

#Region "Functions for load, save, perform operations on the project file and compile the project"

    Public Function Load() As Boolean

        Dim sLine As String

        If Not IsValid Then
            Return False
        End If

        Dim LineStream As StreamReader = Nothing

        Try

            LineStream = New StreamReader(_ProjectFilePath, Encoding.Default)

            While Not LineStream.EndOfStream

                sLine = LineStream.ReadLine

                Lines.Add(sLine)
                LinesOriginal.Add(sLine)

            End While

        Catch

            Throw New Exception("> Error occurred while loading the project")

        Finally

            If LineStream IsNot Nothing Then LineStream.Close()

            LineStream = Nothing

        End Try

        Return True


    End Function

    Public Function SaveOriginal() As Boolean

        If Not IsValid Or LinesOriginal.Count = 0 Then
            Return False
        End If

        Dim LineStream As StreamWriter = Nothing
        Dim boReadOnly As Boolean = False

        Try

            If (File.GetAttributes(_ProjectFilePath) And FileAttributes.ReadOnly) = FileAttributes.ReadOnly Then
                boReadOnly = True
                File.SetAttributes(_ProjectFilePath, FileAttributes.Normal)
            End If

            LineStream = New StreamWriter(_ProjectFilePath, False, Encoding.Default)

            For Each Line As String In LinesOriginal

                LineStream.WriteLine(Line)

            Next

        Catch ex As Exception

            Throw New Exception("> Error occurred saving the project")

        Finally

            If LineStream IsNot Nothing Then LineStream.Close()

            LineStream = Nothing

            If boReadOnly = True Then

                File.SetAttributes(_ProjectFilePath, FileAttributes.ReadOnly)

            End If

        End Try

        Return True

    End Function

    Public Function Save() As Boolean

        If Not IsValid Or Lines.Count = 0 Then
            Return False
        End If

        Dim LineStream As StreamWriter = Nothing
        Dim boReadOnly As Boolean = False

        Try

            If (File.GetAttributes(_ProjectFilePath) And FileAttributes.ReadOnly) = FileAttributes.ReadOnly Then
                boReadOnly = True
                File.SetAttributes(_ProjectFilePath, FileAttributes.Normal)
            End If

            LineStream = New StreamWriter(_ProjectFilePath, False, Encoding.Default)

            For Each Line As String In Lines

                LineStream.WriteLine(Line)

            Next

        Catch ex As Exception

            Throw New Exception("> Error occurred saving the project")

        Finally

            If LineStream IsNot Nothing Then LineStream.Close()

            LineStream = Nothing

            If boReadOnly = True Then

                File.SetAttributes(_ProjectFilePath, FileAttributes.ReadOnly)

            End If

        End Try

        Return True

    End Function

    Public Function SaveAs(ByVal OutDirectory As String) As Boolean

        If Not IsValid Or Lines.Count = 0 Then
            Return False
        End If

        Dim LineStream As StreamWriter = Nothing
        Dim boReadOnly As Boolean = False
        Dim ProjectFilePathNew As String = ""

        Try

            If Not Directory.Exists(OutDirectory) Then

                Throw New Exception("> Out directory does not valid or not exist.")

            End If
            ProjectFilePathNew = Path.Combine(OutDirectory, Path.GetFileName(_ProjectFilePath))

            'if exist file then checking attributes
            If File.Exists(ProjectFilePathNew) Then

                If (File.GetAttributes(ProjectFilePathNew) And FileAttributes.ReadOnly) = FileAttributes.ReadOnly Then
                    boReadOnly = True
                    File.SetAttributes(ProjectFilePathNew, FileAttributes.Normal)
                End If

            End If

            LineStream = New StreamWriter(ProjectFilePathNew, False, Encoding.Default)

            For Each Line As String In Lines

                LineStream.WriteLine(Line)

            Next

        Catch

            Throw New Exception("> Error occurred saving the project")

        Finally

            If LineStream IsNot Nothing Then LineStream.Close()

            LineStream = Nothing

            If boReadOnly = True Then

                File.SetAttributes(ProjectFilePathNew, FileAttributes.ReadOnly)

            End If

        End Try

        Return True

    End Function


    Public Function SetProjectProperty(ByVal Name As String, ByVal value As String, ByVal AddProp As Boolean) As Boolean

        If Name = "" Or value = "" Then
            Return False
        End If

        Dim iIndex As Integer

        For iIndex = 0 To Lines.Count - 1

            Dim sBuffer As String = UCase(Lines(iIndex))

            If sBuffer.StartsWith(UCase(Name) & "=") = True Then

                Lines(iIndex) = Mid(Lines(iIndex), 1, Len(Name & "=")) & value
                Return True

            End If

        Next

        If AddProp Then
            Lines.Add(Name & "=" & value)
            Return True
        End If

        Return False

    End Function

    Public Function GetProjectProperty(ByVal Name As String, ByRef value As String) As Boolean

        For Each Line As String In Lines

            Dim sBuffer As String = UCase(Line)

            If sBuffer.StartsWith(UCase(Name) & "=") = True Then

                value = Mid(Line, 1 + Len(Name & "="))
                Return True

            End If

        Next

        Return False

    End Function

    Public Function SetPathReferences(ByVal PreviousPath As String, ByVal NewPath As String) As Boolean

        If PreviousPath = "" Or NewPath = "" Then
            Return False
        End If

        Dim iIndex As Integer
        Dim bChanged As Boolean = False
        Dim iPos As Integer

        For iIndex = 0 To Lines.Count - 1

            Dim sBuffer As String = UCase(Lines(iIndex))

            If sBuffer.StartsWith("REFERENCE=") = True Then
                iPos = InStr(sBuffer, UCase(PreviousPath))

                If iPos > 0 Then

                    PreviousPath = Mid(Lines(iIndex), iPos, PreviousPath.Length)
                    Lines(iIndex) = Replace(Lines(iIndex), PreviousPath, NewPath)
                    bChanged = True

                End If

            End If

        Next

        Return bChanged

    End Function

    Public Function SortReferences(ByRef ReferencesOrder() As String) As Boolean

        If ReferencesOrder Is Nothing Then
            Return False 'We do not change because there are no references
        End If

        Dim iIndex As Integer
        Dim sBuffer As String
        Dim ReferencesProject As New List(Of String)
        Dim ReferencesProjectSort As New List(Of String)
        Dim iReference As Integer
        Dim bExternal As Boolean

        'Get References Project
        For iIndex = 0 To Lines.Count - 1

            sBuffer = UCase(Lines(iIndex))

            If sBuffer.StartsWith("REFERENCE=") Or sBuffer.StartsWith("OBJECT=") Then

                ReferencesProject.Add(Lines(iIndex))

            End If

        Next

        'Sort References
        For Each ReferenceProject As String In ReferencesProject
            bExternal = True
            For Each ReferenceList As String In ReferencesOrder
                If InStr(UCase(ReferenceProject), UCase(ReferenceList)) > 0 Then
                    bExternal = False
                End If
            Next
            If bExternal Then
                ReferencesProjectSort.Add(ReferenceProject)
            End If
        Next

        For Each ReferenceList As String In ReferencesOrder
            For Each ReferenceProject As String In ReferencesProject
                If InStr(UCase(ReferenceProject), UCase(ReferenceList)) > 0 Then
                    ReferencesProjectSort.Add(ReferenceProject)
                End If
            Next
        Next

        'Update Sort References Project
        iReference = 0
        For iIndex = 0 To Lines.Count - 1

            sBuffer = UCase(Lines(iIndex))

            If sBuffer.StartsWith("REFERENCE=") Or sBuffer.StartsWith("OBJECT=") Then

                Lines(iIndex) = ReferencesProjectSort.Item(iReference)
                iReference += 1

            End If

        Next

        Return True

    End Function

    Public Function ReplaceCLSID(ByRef ComponentsList As List(Of String), ByRef CLSIDList As List(Of String)) As Boolean

        If ComponentsList.Count = 0 Then
            Return True 'We do not change because there are no components
        End If

        Dim iIndex As Integer
        Dim bChanged As Boolean = False
        Dim iPos As Integer
        Dim iCLSIDLength As Integer
        Dim iComponentLength As Integer
        Dim sNewCLSID As String

        For iIndex = 0 To Lines.Count - 1

            Dim sBuffer As String = UCase(Lines(iIndex))
            Dim sPreviousCLSID As String = ""
            iPos = 0

            If sBuffer.StartsWith("REFERENCE=") Or sBuffer.StartsWith("OBJECT=") Then

                If sBuffer.StartsWith("REFERENCE=") Then
                    iPos = InStr(sBuffer, ".DLL") 'DLL ACTIVEX
                    If iPos = 0 Then
                        iPos = InStr(sBuffer, ".TLB") 'DLL.NET ACTIVEX
                        If iPos = 0 Then
                            iPos = InStr(sBuffer, ".EXE") 'EXE ACTIVEX
                        End If

                    End If

                    'reemplace version
                    iCLSIDLength = InStrRev(sBuffer, "#0#") - InStr(Lines(iIndex), "{")
                    iComponentLength = InStrRev(sBuffer, "\")

                End If

                If sBuffer.StartsWith("OBJECT=") Then
                    iPos = InStr(sBuffer, ".OCX") 'OCX ACTIVEX
                    'conserve version
                    iCLSIDLength = InStrRev(sBuffer, "#0;") - InStr(Lines(iIndex), "{")
                    iComponentLength = InStrRev(sBuffer, ";")

                End If

                If iPos > 0 Then
                    sBuffer = Trim(Mid(sBuffer, iComponentLength + 1, (iPos + 3) - iComponentLength))

                    If ComponentsList.Contains(sBuffer) Then

                        sPreviousCLSID = Mid(Lines(iIndex), InStr(Lines(iIndex), "{"), iCLSIDLength)
                        sNewCLSID = CLSIDList.Item(ComponentsList.IndexOf(sBuffer))

                        'If only shown the CLSID and not shown the mayor and minor version,
                        'then we must only modify the CLSID.
                        If InStr(sNewCLSID, "#") = 0 Then
                            sPreviousCLSID = Mid(sPreviousCLSID, 1, InStr(sPreviousCLSID, "#") - 1)
                        End If

                        Lines(iIndex) = Replace(Lines(iIndex), sPreviousCLSID, sNewCLSID)
                        bChanged = True

                    End If

                End If

            End If

        Next

        Return bChanged

    End Function

    Public Function Build() As Boolean
        Dim oTime As Stopwatch
        Dim sResult As String = ""
        Dim sDirectoryLog As String = Path.Combine(BuildsDirectory, "Logs")
        Dim sLog As String = Path.Combine(sDirectoryLog, _
                             Path.GetFileNameWithoutExtension(_ProjectFilePath) & ".Log")

        Dim sProcess As String = Trim(CompilerFilePath) & " " & _
                                 "/make " & Chr(34) & _ProjectFilePath & Chr(34) & " " & _
                                 "/out " & Chr(34) & sLog & Chr(34) & _
                                 "/outdir " & Chr(34) & BuildsDirectory & Chr(34)
        Try

            'if not exist directory logs then create. 
            If Not Directory.Exists(sDirectoryLog) Then
                Directory.CreateDirectory(sDirectoryLog)
            End If

        Catch

            Throw New Exception("> Failed to create logs directory ")

        End Try

        Try
            'initialize time
            oTime = Stopwatch.StartNew()

            'Starting compilation
            WriteLog(BuildsDirectory, "> Starting compilation of '" & NameFileBuild & "' ...", eTypeLog.Robot)

            'Run compilation
            Call Shell(sProcess, AppWinStyle.NormalFocus, True)

            If File.Exists(sLog) Then

                'Result compilation
                sResult = Replace(Trim(GetAllTextFileEncondingDefault(sLog)), vbCrLf, "")
                WriteLog(BuildsDirectory, "> Result of the compilation: " & sResult, eTypeLog.Robot)
                File.Delete(sLog)

            End If

            If File.Exists(Path.Combine(BuildsDirectory, NameFileBuild)) Then

                'If the compilation has successfully completed then we get the 
                'values of the component and delete temporal files.
                File.Delete(Path.Combine(BuildsDirectory, Path.GetFileNameWithoutExtension(NameFileBuild) & ".lib"))
                File.Delete(Path.Combine(BuildsDirectory, Path.GetFileNameWithoutExtension(NameFileBuild) & ".exp"))

                oComponent = New Component(Path.Combine(BuildsDirectory, NameFileBuild))

                WriteLog(BuildsDirectory, "> Consumed time: " & Mid(oTime.Elapsed.ToString, 1, 8) & ".", eTypeLog.Robot)
                WriteLog(BuildsDirectory, "> Complete compilation of the component '" & NameFileBuild & "'.", eTypeLog.Robot)

            Else

                'If the compilation has been incorrect.
                WriteLog(BuildsDirectory, "> Consumed time: " & Mid(oTime.Elapsed.ToString, 1, 8) & ".", eTypeLog.Robot)
                WriteLog(BuildsDirectory, "> Compilation of the component '" & NameFileBuild & "' has completed with errors.", eTypeLog.Robot)
                WriteLog(BuildsDirectory, "> " & NameFileBuild & ": " & sResult, eTypeLog.Builds)
                Return False

            End If

            Return True

        Catch

            Throw New Exception("> Failed to run the compilation of the project")

        Finally

            oTime = Nothing

        End Try

        Return False

    End Function

#End Region

End Class

